﻿module HostObjectReflection

open System
open System.Reflection
open Microsoft.FSharp.Reflection
open JsTypes
open ScriptingExposedAttribute


let isExposeAttribute (att:CustomAttributeData) = att.AttributeType=typedefof<ScriptingExposedAttribute>

let getExposedMember hostObj propName =
    let members = hostObj.GetType().GetMember(propName, 
                    BindingFlags.Public |||    
                    BindingFlags.Instance |||
                    BindingFlags.FlattenHierarchy)
    let mem1 = [for mem in members do
                   let att = Seq.tryFind isExposeAttribute mem.CustomAttributes
                   if att.IsSome then yield (mem, att.Value)]
    do if mem1.Length=0 then failwithf "Exposed member not found: %s" propName
    do if mem1.Length>1 then failwithf "Multiple exposed members found: %s" propName
    let member1, att = mem1.[0]
    member1, att

let isExposedType (tp:System.Type) =
    Seq.exists isExposeAttribute tp.CustomAttributes

(* Converts js arguments to the expected native types *)
let convertToNative (prm:ParameterInfo, jsVal:JsValue) : System.Object = 
    if prm.ParameterType = typedefof<JsValue> then jsVal :> System.Object
    elif prm.ParameterType=typedefof<System.String> then (ToString(jsVal)) :> System.Object
    elif isExposedType(prm.ParameterType) then failwith "Not supported yet"
    else failwithf "Parameter type not supported: %s" (prm.ParameterType.ToString())

let convertArgsToExpected (prms:ParameterInfo[]) (args:JsValue list) =
    // fill remaining args with undefineds
    let args = args @ List.init (prms.Length-args.Length) (fun ix->Undefined) 
    List.zip (List.ofArray prms) args |> List.map convertToNative


let isOption (obj:Object) =
    obj.GetType().IsGenericType && obj.GetType().GetGenericTypeDefinition()=typedefof<Option<_>>

let unwrapBoxedOption (obj:Object) =
    let info = FSharpValue.GetUnionFields(obj, obj.GetType(), 
                    BindingFlags.Public ||| BindingFlags.Static)
    let caseInfo, objs = info;
    match caseInfo.Name with
        | "Some" -> Some(objs.[0])
        | "None" -> None

let boxedOptionToNullable (opt:Object) : Object =
    match unwrapBoxedOption opt with
    | Some obj -> obj
    | None -> null

[<AbstractClass>]
type BaseWrapper() =    
    member this.wrapValue value =
        if value = null
        then NullValue
        elif isOption value
        then this.wrapValue (boxedOptionToNullable value)
        else
                match value with
                | :? System.String as str -> StringValue(str)
                | _ -> this.wrapObject value

    member this.wrapObject (obj:Object) =
        if not (isExposedType (obj.GetType())) then failwithf "Objects not exposed: %s" (obj.GetType().ToString())
        Object(HostObjectWrapper(obj))

    interface IObject with
        member this.Call thisArg args = Undefined
        member this.GetProperty name = None
        member this.GetOwnProperty name = None
        member this.Get name = 
            match ((this :> IObject).GetProperty name) with
            | Some desc -> desc.GetValue()
            | None -> Undefined
        member this.CanPut name = false
        member this.Put name value = ()
        member this.HasProperty name = false
        member this.Delete property x = false
        member this.DefaultValue hint = StringValue("[HostObject]")
        member this.DefineOwnProperty name descriptior isMutable = ()
        member this.Construct args = failwith "Not a constructor"
        member this.ImplementsCall = false

    (* 
        A wrapper for a regular method.
        Invokes the method via reflection
    *)
and MethodWrapper(obj:Object, met:MethodInfo, att:CustomAttributeData) =
    inherit BaseWrapper()
    let _obj : Object = obj
    let _met = met    
  
    interface IObject with
        override this.ImplementsCall = true
        override this.Call thisArg args = 
            let prms = met.GetParameters()
            let nativeArgs = convertArgsToExpected prms args
            let result = _met.Invoke(obj, (Array.ofList nativeArgs))
            this.wrapValue(result)        
       
    (* 
        A wrapper for a regular object.
        Calls methods and accesses properties via reflection
    *)
and HostObjectWrapper(obj) =
    inherit BaseWrapper()
    let _obj = obj
    
    interface IObject with
        override this.GetProperty name =
            let mem, att = getExposedMember _obj name
            match mem with
            | :? MethodInfo as metode -> 
                Some(PropertyDescriptor(Object(MethodWrapper(_obj, metode, att))))
            | :? PropertyInfo as prop -> 
                Some(PropertyDescriptor(this.wrapValue(prop.GetValue(_obj))))

        override this.Put name value = ()
        override this.Get name = 
            match (this :> IObject).GetProperty name with
            | Some desc -> desc.GetValue()
            | None -> Undefined